R Notebook

install.packages("openxlsx")

trying URL 'https://cran.rstudio.com/bin/macosx/big-sur-x86_64/contrib/4.4/openxlsx_4.2.7.1.tgz'
Content type 'application/x-gzip' length 3348577 bytes (3.2 MB)
==================================================
downloaded 3.2 MB

The downloaded binary packages are in
    /var/folders/q7/82r_8nhs24sb_y_92qfw5sdw0000gn/T//Rtmp3TI802/downloaded_packages

# Instalar el paquete si no está instalado
if (!require("dplyr")) install.packages("dplyr")

Loading required package: dplyr

Attaching package: ‘dplyr’

The following objects are masked from ‘package:stats’:

    filter, lag

The following objects are masked from ‘package:base’:

    intersect, setdiff, setequal, union

# Cargar el paquete
library(dplyr)

Trabajo Práctico Final

1) Fuente de datos

Carga el dataset

.

library(openxlsx)
delitos <- read.xlsx("/Users/bquinonez/Downloads/delitos_2023.xlsx")
delitos

summary(delitos)

     id-sum            anio          mes                dia                fecha           franja     
 Min.   :     1   Min.   :2023   Length:157461      Length:157461      Min.   :44927   Min.   : 0.00  
 1st Qu.: 39366   1st Qu.:2023   Class :character   Class :character   1st Qu.:45021   1st Qu.: 8.00  
 Median : 78731   Median :2023   Mode  :character   Mode  :character   Median :45113   Median :13.00  
 Mean   : 78731   Mean   :2023                                         Mean   :45112   Mean   :12.95  
 3rd Qu.:118096   3rd Qu.:2023                                         3rd Qu.:45204   3rd Qu.:18.00  
 Max.   :157461   Max.   :2023                                         Max.   :45291   Max.   :23.00  
     tipo             subtipo            uso_arma           uso_moto            barrio         
 Length:157461      Length:157461      Length:157461      Length:157461      Length:157461     
 Class :character   Class :character   Class :character   Class :character   Class :character  
 Mode  :character   Mode  :character   Mode  :character   Mode  :character   Mode  :character  
                                                                                               
                                                                                               
                                                                                               
    comuna            latitud            longitud            cantidad
 Length:157461      Length:157461      Length:157461      Min.   :1  
 Class :character   Class :character   Class :character   1st Qu.:1  
 Mode  :character   Mode  :character   Mode  :character   Median :1  
                                                          Mean   :1  
                                                          3rd Qu.:1  
                                                          Max.   :1  

dim(delitos)

[1] 157461     15

El dataset antes del preprocesamiento cuenta con 15 columnas y 157.461 registros correspondientes al año 2023.

2) Preprocesamiento

Verificación de nulos

colSums(is.na(delitos))

  id-sum     anio      mes      dia    fecha   franja     tipo  subtipo uso_arma uso_moto   barrio 
       0        0        0        0        0        0        0        0        0        0       35 
  comuna  latitud longitud cantidad 
       0        9        9        0 

Tipos de Delitos

cantidad_valores_unicos <- (unique(delitos$tipo))
print(cantidad_valores_unicos)

[1] "Vialidad"   "Lesiones"   "Amenazas"   "Hurto"      "Robo"       "Homicidios"

Subtipos de delitos

conteo_por_tipo <- table(delitos$tipo)
print(conteo_por_tipo)

  Amenazas Homicidios      Hurto   Lesiones       Robo   Vialidad 
      8332         91      62567      11045      64983      10443 

cantidad_valores_unicos <- (unique(delitos$subtipo))
print(cantidad_valores_unicos)

[1] "Muertes por siniestros viales"  "Lesiones por siniestros viales" "Lesiones Dolosas"              
[4] "Amenazas"                       "Hurto total"                    "Robo total"                    
[7] "Hurto automotor"                "Robo automotor"                 "Homicidio Doloso"              

conteo_por_subtipo <- table(delitos$subtipo)
print(conteo_por_subtipo)

                      Amenazas               Homicidio Doloso                Hurto automotor 
                          8332                             91                           4494 
                   Hurto total               Lesiones Dolosas Lesiones por siniestros viales 
                         58073                          11045                          10339 
 Muertes por siniestros viales                 Robo automotor                     Robo total 
                           104                            904                          64079 

Creación de variables

Agregamos la columna de franja horaria

library(dplyr)
#Genero la columna franja(horaria)
delitos <- delitos %>%
  mutate(
    franja_horaria = case_when(
      franja >= 6 & franja < 12 ~ "Mañana",
      franja >= 12 & franja < 18 ~ "Tarde",
      franja >= 18 & franja < 24 ~ "Noche",
      franja >= 0 & franja < 6  ~ "Madrugada",
      TRUE ~ "Desconocido" # Para casos fuera de rango 
    )
  )
delitos

Agregamos una columna que indica si es fin de semana o día de semana

delitos$tipo_dia <- ifelse(delitos$dia %in% c("SAB", "DOM"),
                                             "Fin de semana", "Día de semana")
delitos

Agregamos una columna que indica la estación del año

# Crear columna 'estacion' basada en el mes
delitos <- delitos %>%
  mutate(
    estacion = case_when(
      mes %in% c("diciembre", "enero", "febrero") ~ "Verano",
      mes %in% c("marzo", "abril", "mayo")       ~ "Otoño",
      mes %in% c("junio", "julio", "agosto")     ~ "Invierno",
      mes %in% c("septiembre", "octubre", "noviembre") ~ "Primavera",
      TRUE ~ "Desconocido" # Para casos no esperados
    )
  )
delitos

Conversión de longitud y latitud

# Convertir longitud y latitud a numéricas y escalarlas correctamente
delitos <- delitos %>%
  mutate(
    longitud = as.numeric(longitud) / 1e6,  # Escalar dividiendo entre 10^6
    latitud = as.numeric(latitud) / 1e6    # Escalar dividiendo entre 10^6
  )

Warning: There were 2 warnings in `mutate()`.
The first warning was:
ℹ In argument: `longitud = as.numeric(longitud)/1e+06`.
Caused by warning:
! NAs introduced by coercion
ℹ Run ]8;;ide:run:dplyr::last_dplyr_warnings()dplyr::last_dplyr_warnings()]8;; to see the 1 remaining warning.

# Verificar las primeras filas para confirmar
head(delitos[c("longitud", "latitud")])

Eliminación de nulos y barrios que no forman parte de CABA

library(stringr)
delitos <- na.omit(delitos)
dim(delitos)

[1] 154521     18

delitos <- delitos %>% 
  filter(barrio != "0", barrio != "Sin geo", barrio != "NULL", barrio != "NO ESPECIFICADA", barrio != "GREGORIO DE LAFERRERE") %>%
  mutate(barrio = str_replace_all(barrio, "NUNEZ", "NUÑEZ"))

3) Aplicación de FDA

Armamos la agrupación por barrio y fecha y creamos la matriz funcinal con barrios como filas y fechas como columnas

# Cargar librerías necesarias
if (!require("RColorBrewer")) install.packages("RColorBrewer")

Loading required package: RColorBrewer

library(RColorBrewer)
library(dplyr)
library(tidyr)
library(fda.usc)

Loading required package: fda
Loading required package: splines
Loading required package: fds
Loading required package: rainbow
Loading required package: MASS

Attaching package: ‘MASS’

The following object is masked from ‘package:dplyr’:

    select

Loading required package: pcaPP
Loading required package: RCurl

Attaching package: ‘RCurl’

The following object is masked from ‘package:tidyr’:

    complete

Loading required package: deSolve

Attaching package: ‘fda’

The following object is masked from ‘package:graphics’:

    matplot

Loading required package: mgcv
Loading required package: nlme

Attaching package: ‘nlme’

The following object is masked from ‘package:dplyr’:

    collapse

The following object is masked from ‘package:rrcov’:

    getData

This is mgcv 1.9-1. For overview type 'help("mgcv-package")'.
Loading required package: knitr
 fda.usc is running sequentially usign foreach package
 Please, execute ops.fda.usc() once to run in local parallel mode
 Deprecated functions: min.basis, min.np, anova.hetero, anova.onefactor, anova.RPm
 New functions: optim.basis, optim.np, fanova.hetero, fanova.onefactor, fanova.RPm
----------------------------------------------------------------------------------

library(fda)
library(ggplot2)
library(ggrepel)
library(tibble)  # Para usar column_to_rownames

# Paso 1: Agrupar datos y preparar la matriz funcional
# Agrupar por barrio y fecha, sumando la frecuencia de delitos
delitos_agrupados_barrio <- delitos %>%
  group_by(barrio, fecha) %>%
  summarise(frecuencia_diaria = sum(cantidad, na.rm = TRUE), .groups = "drop")

# Crear matriz funcional: barrios como filas, fechas como columnas
delitos_matrix <- delitos_agrupados_barrio %>%
  pivot_wider(names_from = fecha, values_from = frecuencia_diaria, values_fill = 0) %>%
  column_to_rownames(var = "barrio") %>%
  as.matrix()

# Eliminar filas con valores faltantes y verificar la variabilidad
delitos_matrix <- delitos_matrix[complete.cases(delitos_matrix), ]
variabilidad <- apply(delitos_matrix, 1, var, na.rm = TRUE)
delitos_matrix <- delitos_matrix[variabilidad > 0.01, ]

a) SIN FDA: Creamos las curvas por barrio a lo largo del 2023 sin FDA.

# Crear un vector de fechas reales
fechas_date <- seq.Date(from = as.Date("2023-01-01"), by = "day", length.out = ncol(delitos_matrix))

# Graficar curvas originales por barrio sin aplicar FDA
# Crear el gráfico con dimensiones ampliadas
png("grafico_sin_fda.png", width = 2000, height = 1200, res = 150)  # Resolución más alta

# Ajustar márgenes: más espacio izquierdo para la leyenda
par(mar = c(10, 35, 4, 4) + 0.1)  # Aumentar margen izquierdo

# Crear colores únicos para cada barrio
colores <- rainbow(nrow(delitos_matrix))

# Graficar las curvas originales
matplot(fechas_date, t(delitos_matrix), type = "l", lty = 1, col = colores, lwd = 2,
        xlab = "Fecha", ylab = "Frecuencia", xaxt = "n",
        main = "Curvas por Barrio (Sin suavizado)")

NULL

# Crear etiquetas de fechas en el eje X
fechas_etiquetas <- seq(min(fechas_date), max(fechas_date), by = "2 weeks")  # Mostrar cada dos semanas
axis(1,
     at = as.numeric(fechas_etiquetas),  # Usar fechas reales como índices
     labels = format(fechas_etiquetas, "%d %b"),  # Día y mes
     las = 2,  # Rotar las etiquetas
     cex.axis = 0.8)  # Tamaño del texto en el eje Xpe

# Crear una leyenda más amplia en el margen izquierdo
legend("topright",
       inset = c(1.2, 0),   # Más espacio hacia la izquierda
       rownames(delitos_matrix),
       col = colores,
       lty = 1,
       lwd = 4,  # Grosor de las líneas
       ncol = 2,  # Dividir la leyenda en dos columnas
       cex = 0.9,  # Tamaño del texto más grande
       xpd = TRUE)  # Permitir que la leyenda esté fuera del área de dibujo

# Guardar y cerrar el archivo PNG
dev.off()

null device 
          1 

# Verificar que el archivo fue creado
browseURL("grafico_sin_fda.png")

Curvas por Barrio (Sin FDA ni suavizado)

Aaplicamos clustering sobre los datos sin FDA

dim(delitos_matrix)  # Deberías ver (n_barrio, n_fechas)

[1]  48 365

delitos_matrix_normalized <- scale(delitos_matrix)

library(factoextra)

Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa

# Método del codo para determinar el número óptimo de clusters
fviz_nbclust(delitos_matrix_normalized, kmeans, method = "wss") +
  labs(title = "Método del Codo")

fviz_nbclust(delitos_matrix_normalized, kmeans, method = "silhouette") +
  labs(title = "Índice de Silhouette")

Aplicamos los clusters

set.seed(123)  # Para reproducibilidad
num_clusters <- 2  # Cambia según los resultados del método del codo o Silhouette

kmeans_result <- kmeans(delitos_matrix_normalized, centers = num_clusters, nstart = 20)

clusters <- data.frame(
  barrio = rownames(delitos_matrix),
  cluster = kmeans_result$cluster
)

# Ordenar el dataframe por cluster
clusters_ordenados <- clusters %>%
  arrange(cluster)


# Ver los primeros resultados
print(clusters_ordenados)

NA
NA

Usamos PCA para graficar los clusters

library(ggplot2)
library(dplyr)

# Calcular la cantidad de barrios por cluster
cluster_sizes <- clusters %>%
  group_by(cluster) %>%
  summarise(n_barrios = n()) %>%
  mutate(cluster_label = paste0("Cluster ", cluster, " (n=", n_barrios, ")"))

# Convertir `cluster` a character o factor en ambos dataframes
pca_data <- as.data.frame(pca_result$x[, 1:2])  # Tomar las dos primeras componentes
pca_data$cluster <- as.factor(clusters$cluster)  # Convertir a factor

cluster_sizes$cluster <- as.factor(cluster_sizes$cluster)  # Convertir a factor

# Combinar con las etiquetas personalizadas
pca_data <- pca_data %>%
  left_join(cluster_sizes, by = "cluster")

# Graficar PCA con leyenda personalizada
ggplot(pca_data, aes(x = PC1, y = PC2, color = cluster_label)) +
  geom_point(size = 3, alpha = 0.7) +  # Puntos para los barrios
  theme_minimal() +
  labs(
    title = "Clusters Visualizados en el Espacio PCA",
    x = "PC1",
    y = "PC2",
    color = "Cluster"
  ) +
  theme(legend.position = "bottom")

NA
NA

delitos_df <- as.data.frame(delitos_matrix) %>%
  rownames_to_column(var = "barrio")  # Convertir rownames en columna llamada 'barrio'
resumen_clusters <- clusters %>%
  left_join(delitos_df, by = "barrio") %>%  # 'barrio' ya es una columna explícita
  group_by(cluster) %>%
  summarise_all(mean, na.rm = TRUE)

Warning: There were 2 warnings in `summarise()`.
The first warning was:
ℹ In argument: `barrio = (function (x, ...) ...`.
ℹ In group 1: `cluster = 1`.
Caused by warning in `mean.default()`:
! argument is not numeric or logical: returning NA
ℹ Run ]8;;ide:run:dplyr::last_dplyr_warnings()dplyr::last_dplyr_warnings()]8;; to see the 1 remaining warning.

print(resumen_clusters)

NA

Aplicamos silhouette para validar los clusters

library(cluster)

# Calcular índice de Silhouette
silhouette_result <- silhouette(kmeans_result$cluster, dist(delitos_matrix_normalized))

# Resumen del índice de Silhouette
summary(silhouette_result)

Silhouette of 48 units in 2 clusters from silhouette.default(x = kmeans_result$cluster, dist = dist(delitos_matrix_normalized)) :
 Cluster sizes and average silhouette widths:
       38        10 
0.6097475 0.2389282 
Individual silhouette widths:
    Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
-0.07585  0.40748  0.61745  0.53249  0.70691  0.72233 

# Inspeccionar los valores del índice de Silhouette
head(silhouette_result[, 1:3])  # Cluster, vecino más cercano, valor de Silhouette

     cluster neighbor   sil_width
[1,]       1        2  0.70668284
[2,]       2        1  0.16010046
[3,]       2        1  0.42544455
[4,]       2        1  0.07900193
[5,]       2        1 -0.07585089
[6,]       1        2  0.61609869

# Promedio del índice
mean(silhouette_result[, 3])

[1] 0.5324934

# Visualizar índice de Silhouette
fviz_silhouette(silhouette_result) +
  labs(title = "Índice de Silhouette por Cluster",
       x = "Índice de Silhouette",
       y = "Barrios")

NA

b) CON FDA: Creamos las curvas por barrio a lo largo del 2023 con FDA.

# Paso 2: Representar Datos como Curvas Funcionales con Suavizado

# Crear una base B-spline penalizada para suavizar las funciones
nbasis <- 25  # Ajusta el número de bases para mayor flexibilidad
lambda <- 1e-2  # Parámetro de suavizado; menor valor = más suave

# Crear la base B-spline
basis <- create.bspline.basis(rangeval = range(fechas_date), nbasis = nbasis)

# Definir el objeto de parámetros funcionales con suavizado
fd_par <- fdPar(basis, Lfdobj = int2Lfd(2), lambda = lambda)

# Convertir las filas de la matriz en funciones continuas suavizadas
fd_obj_suavizado <- smooth.basis(fechas_date, t(delitos_matrix), fd_par)$fd

# Visualizar las funciones suavizadas por barrio antes del clustering
colores <- rainbow(nrow(delitos_matrix))  # Generar colores únicos para cada barrio

# Crear el gráfico con dimensiones ampliadas
png("grafico_mejorado_legenda.png", width = 2000, height = 1200, res = 150)  # Resolución más alta

# Ajustar márgenes: más espacio derecho para la leyenda
par(mar = c(10, 4, 4, 35) + 0.1)  # Aumentar margen derecho para que la leyenda no quede cortada

# Graficar las funciones suavizadas
plot(fd_obj_suavizado, main = "Curvas por Barrio suavizadas con FDA",
     xlab = "Fecha", ylab = "Frecuencia",
     col = colores,
     lwd = 2, xaxt = "n")  # Desactivar eje X predeterminado

[1] "done"

# Crear etiquetas de fechas en el eje X
fechas_etiquetas <- seq(min(fechas_date), max(fechas_date), by = "2 weeks")  # Mostrar cada dos semanas
axis(1,
     at = as.numeric(fechas_etiquetas),  # Usar fechas reales como índices
     labels = format(fechas_etiquetas, "%d %b"),  # Día y mes
     las = 2,  # Rotar las etiquetas
     cex.axis = 0.8)  # Tamaño del texto en el eje X

# Crear una leyenda ajustada en el lado derecho del gráfico
legend("topleft",
       inset = c(1.1, 0),  # Reducir el espacio hacia la derecha
       legend = rownames(delitos_matrix),
       col = colores,
       lty = 1,
       lwd = 4,  # Grosor de las líneas
       ncol = 2,  # Dividir la leyenda en dos columnas
       cex = 0.9,  # Tamaño del texto ajustado
       xpd = TRUE)  # Permitir que la leyenda esté fuera del área de dibujo


# Guardar y cerrar el archivo PNG
dev.off()

null device 
          1 

# Verificar que el archivo fue creado
browseURL("grafico_mejorado_legenda.png")

# Paso 3: Clustering Funcional con K-Means
# Determinar el número óptimo de clusters con el método del codo
set.seed(123)
wss <- sapply(2:10, function(k) {
  kmeans(fd_obj_suavizado$coefs, centers = k, nstart = 20)$tot.withinss
})

Curvas por Barrio suavizada con FDA)

Graficamos el método de codo y silhouette para definir el número de clusters

# Graficar el método del codo
plot(2:10, wss, type = "b", pch = 19, frame = FALSE,
     xlab = "Número de Clusters", ylab = "Suma de Errores al Cuadrado (WSS)",
     main = "Método del Codo para Clustering Funcional")

# Elegir un número de clusters (por ejemplo, 3)
num_clusters <- 2
kmeans_result <- kmeans(fd_obj_suavizado$coefs, centers = num_clusters, nstart = 20)

fviz_nbclust(fd_obj_suavizado$coefs, kmeans, method = "silhouette") +
  labs(title = "Índice de Silhouette")

Definimos los clusters correspondientes

fd_transposed <- t(fd_obj_suavizado$coefs)

# Aplicar kmeans funcional con manejo de clusters pequeños
num_clusters <- 2  # Cambiar según necesidad

# Aplicar clustering funcional
kmeans_result <- kmeans(t(fd_obj_suavizado$coefs), centers = num_clusters, nstart = 20)

Graficamos los clusters

# Asignar clusters a los barrios
# Crear el dataframe con los barrios y los clusters asignados
clusters <- data.frame(
  barrio = colnames(fd_obj_suavizado$coefs),  # Nombres de los barrios
  cluster = kmeans_result$cluster               # Clusters asignados
)

# Evaluar las curvas funcionales
matriz_evaluada <- t(eval.fd(fechas_date, fd_obj_suavizado))  # Evaluar en fechas_date

# Asignar las fechas como nombres de las columnas
colnames(matriz_evaluada) <- as.character(fechas_date)  # Convertir fechas a texto


# Actualizar etiquetas de los clusters con los tamaños
df_curves <- as.data.frame(matriz_evaluada) %>%
  rownames_to_column("barrio") %>%
  pivot_longer(-barrio, names_to = "fecha", values_to = "frecuencia") %>%
  mutate(
    fecha = as.Date(fecha),  # Convertir texto a objeto Date
    cluster = factor(clusters$cluster[match(barrio, clusters$barrio)])
  )


# Calcular cantidad de barrios únicos por cluster
cluster_sizes <- df_curves %>%
  group_by(cluster) %>%
  summarise(n_barrios = n_distinct(barrio))  # Contar barrios únicos

df_curves <- df_curves %>%
  left_join(cluster_sizes, by = "cluster") %>%  # Agregar tamaños al dataframe
  mutate(cluster_label = paste0("Cluster ", cluster, " (n=", n_barrios, ")"))  # Etiquetas personalizadas


ggplot(df_curves, aes(x = fecha, y = frecuencia, group = barrio, color = cluster_label)) +
  geom_line(alpha = 0.7) +
  theme_minimal() +
  labs(
    title = "Clustering Funcional por Barrio",
    x = "Fecha",
    y = "Frecuencia",
    color = "Cluster"
  ) +
  theme(legend.position = "bottom")

# Crear la tabla con los barrios por cluster
tabla_barrios <- df_curves %>%
  dplyr::select(barrio, cluster_label) %>%  # Seleccionar columnas necesarias
  distinct() %>%                     # Eliminar duplicados
  arrange(cluster_label, barrio)     # Ordenar por cluster y barrio

print(tabla_barrios)

NA

Graficamos las curvas promedios por cluster

# Calcular la frecuencia promedio por cluster y fecha
df_avg <- df_curves %>%
  group_by(cluster_label, fecha) %>%
  summarise(frecuencia_promedio = mean(frecuencia), .groups = "drop")

ggplot() +
  # Curvas individuales
  geom_line(data = df_curves, aes(x = fecha, y = frecuencia, group = barrio, color = cluster_label), alpha = 0.4) +
  # Curvas promedio por cluster
  geom_line(data = df_avg, aes(x = fecha, y = frecuencia_promedio, group = cluster_label, color = cluster_label), size = 1.5) +
  theme_minimal() +
  labs(
    title = "Clustering Funcional por Barrio con Curvas Promedio",
    x = "Fecha",
    y = "Frecuencia",
    color = "Cluster"
  ) +
  theme(legend.position = "bottom")

Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
Please use `linewidth` instead.

Validación de clusters con Silhouette

if (!require("cluster")) install.packages("cluster")
if (!require("factoextra")) install.packages("factoextra")
library(cluster)
library(factoextra)

# Asegurar que los clusters coinciden con la matriz
clusters <- df_curves %>%
  distinct(barrio, cluster) %>%
  arrange(barrio)  # Ordenar por barrio para garantizar coincidencia

matriz_clustering <- matriz_clustering[order(rownames(matriz_clustering)), ]  # Ordenar filas por nombre de barrio

# Calcular el índice de Silhouette
silhouette_result <- silhouette(as.numeric(clusters$cluster), dist(matriz_clustering))

Warning: NAs introduced by coercion

# Resumen del índice de Silhouette
summary(silhouette_result)

Silhouette of 48 units in 2 clusters from silhouette.default(x = as.numeric(clusters$cluster), dist = dist(matriz_clustering)) :
 Cluster sizes and average silhouette widths:
       38        10 
0.6933336 0.3951933 
Individual silhouette widths:
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
0.05452 0.51765 0.74675 0.63122 0.77368 0.79867 

# Inspeccionar los valores del índice de Silhouette
head(silhouette_result[, 1:3])  # Cluster, vecino más cercano, valor de Silhouette

     cluster neighbor  sil_width
[1,]       1        2 0.74779439
[2,]       2        1 0.35756135
[3,]       2        1 0.52688158
[4,]       2        1 0.24524335
[5,]       2        1 0.05451973
[6,]       1        2 0.73760567

# Promedio del índice
mean(silhouette_result[, 3])

[1] 0.631221

# Visualizar Silhouette
fviz_silhouette(silhouette_result) +
  labs(title = "Índice de Silhouette por Cluster",
       x = "Índice de Silhouette",
       y = "Barrios") +
  theme_minimal()

NA
NA

c) PCA Funcional: También aplicamos PCA a los coeficientes funcionales y luego calculamos los clusters

# Paso 2: Extraer los coeficientes funcionales
coeficientes <- t(fd_obj_suavizado$coefs)

# Paso 3: Aplicar PCA a los coeficientes funcionales
pca_result <- prcomp(coeficientes, center = TRUE, scale. = TRUE)  # Normalizar para PCA

# Explorar la varianza explicada por las componentes principales
varianza_explicada <- cumsum(pca_result$sdev^2) / sum(pca_result$sdev^2) * 100
print(varianza_explicada)  # Ver proporción de varianza explicada

 [1]  87.95647  91.38211  93.35515  94.71343  95.90995  96.62760  97.19225  97.62889  98.04136  98.42655
[11]  98.74606  98.99938  99.19263  99.34640  99.49113  99.61475  99.71369  99.78494  99.84267  99.88468
[21]  99.92142  99.94973  99.96856  99.98455 100.00000

# Elegir el número de componentes principales
num_componentes <- 2  # Cambiar según necesidad (e.g., varianza explicada > 80%)
scores_pca <- pca_result$x[, 1:num_componentes]  # Tomar los scores de las componentes seleccionadas


# Paso 4: Aplicar k-means usando los scores de PCA
set.seed(123)  # Para reproducibilidad
num_clusters <- 2  # Cambiar según necesidad
kmeans_result <- kmeans(scores_pca, centers = num_clusters, nstart = 20)

# Ver los clusters asignados
clusters <- data.frame(
  barrio = colnames(fd_obj_suavizado$coefs),
  cluster = kmeans_result$cluster
)

# Ordenar el dataframe por cluster
clusters_ordenados <- clusters %>%
  arrange(cluster)


# Ver los primeros resultados
print(clusters_ordenados)

library(ggplot2)

# Crear un dataframe con las dos primeras componentes principales y los clusters
df_pca <- as.data.frame(scores_pca)  # Convertir los scores seleccionados a dataframe
df_pca$cluster <- as.factor(kmeans_result$cluster)  # Agregar los clusters asignados
df_pca$barrio <- colnames(fd_obj_suavizado$coefs)  # Agregar nombres de los barrios

library(ggplot2)
library(dplyr)

# Calcular la cantidad de barrios por cluster
cluster_sizes <- df_pca %>%
  group_by(cluster) %>%
  summarise(n_barrios = n())  # Contar barrios por cluster

# Crear etiquetas personalizadas para la leyenda
cluster_labels <- cluster_sizes %>%
  mutate(cluster_label = paste0("Cluster ", cluster, " (n=", n_barrios, ")")) %>%
  pull(cluster_label)  # Extraer etiquetas como vector

# Mapear las etiquetas a los clusters
names(cluster_labels) <- cluster_sizes$cluster  # Asignar etiquetas por número de cluster

# Graficar los clusters en el espacio PCA con las etiquetas personalizadas
ggplot(df_pca, aes(x = PC1, y = PC2, color = cluster)) +
  geom_point(size = 3, alpha = 0.7) +  # Representar los puntos
  theme_minimal() +
  labs(
    title = "Clusters Visualizados en el Espacio PCA",
    x = "Componente Principal 1",
    y = "Componente Principal 2",
    color = "Cluster"
  ) +
  theme(legend.position = "bottom") +
  scale_color_manual(
    values = c("#1b9e77", "#d95f02", "#7570b3", "#e7298a"),  # Colores personalizados
    labels = cluster_labels  # Etiquetas con la cantidad de barrios
  )

NA
NA

Validación de clusters nuevamente con Silhouette

library(cluster)
library(factoextra)

# Calcular la matriz de distancias usando los scores PCA
dist_pca <- dist(df_pca[, c("PC1", "PC2")])

# Calcular el índice de Silhouette
silhouette_result <- silhouette(as.numeric(df_pca$cluster), dist_pca)

# Ver un resumen del índice de Silhouette
summary(silhouette_result)

Silhouette of 48 units in 2 clusters from silhouette.default(x = as.numeric(df_pca$cluster), dist = dist_pca) :
 Cluster sizes and average silhouette widths:
       38        10 
0.6837485 0.4056394 
Individual silhouette widths:
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
0.02632 0.53374 0.74402 0.62581 0.77813 0.79962 

# Promedio del índice de Silhouette
silhouette_avg <- mean(silhouette_result[, 3])
print(paste("Índice de Silhouette promedio:", round(silhouette_avg, 3)))

[1] "Índice de Silhouette promedio: 0.626"

# Visualizar el índice de Silhouette
fviz_silhouette(silhouette_result) +
  labs(
    title = "Índice de Silhouette para Clusters en PCA",
    x = "Índice de Silhouette",
    y = "Barrios"
  ) +
  theme_minimal()

NA
NA
NA